Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d12/v9n21.arc/DGDIALOG.PAS

Pascal/Delphi Source File | 1990-11-17 | 54KB | 1,479 lines

{
 ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄
 █                                                                         █
 █        TITLE :      DGDIALOG.TPU                                        █
 █      PURPOSE :      Dialog Boxes and Message Routines.                  █
 █       AUTHOR :      David Gerrold, CompuServe ID:  70307,544            █
 █ ______________________________________________________________________  █
 █                                                                         █
 █   Written in Turbo Pascal, Version 5.5,                                 █
 █   with routines from TurboPower, Object Professional.                   █
 █                                                                         █
 █   Turbo Pascal is a product of Borland International.                   █
 █   Object Professional is a product of TurboPower Software.              █
 █ ______________________________________________________________________  █
 █                                                                         █
 █   This is not public domain software.                                   █
 █   This software is copyright (c) 1990, by David Gerrold.                █
 █   Permission is hereby granted for personal use.                        █
 █                                                                         █
 █        The Brass Cannon Corporation                                     █
 █        9420 Reseda Blvd., #804                                          █
 █        Northridge, CA  91324-2932.                                      █
 █                                                                         █
 ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
                                                                            }
{ Compiler Directives ===================================================== }

{$A-}    {Switch word alignment off, necessary for cloning}
{$R-}    {Range checking off}
{$B-}    {Boolean complete evaluation off}
{$S-}    {Stack checking off}
{$I-}    {I/O checking off}
{$N+,E+} {Simulate numeric coprocessor}
{$M 16384,0,327680} {stack and heap}
{$V-}    {Variable range checking off}

{ Name ==================================================================== }

UNIT DgDialog;
{
  The purpose of DgDialog is to provide a Dialog Box object and several
  basic implementations of it.  Also included are several other message
  routines.
}

{ Interface =============================================================== }

INTERFACE

USES
{ Object Professional Units }
  OpDos,
  OpDate,
  OpCmd,
  OpColor,
  OpCrt,
  OpFrame,
  OpInline,
  OpMenu,
  OpMouse,
  OpRoot,
  OpString,
  OpWindow,

{ DgUnits }
  DgMath,
  DgWryte,
  DgSound,
  DgDate,
  DgFile,
  DgReboot,
  DgDec,
  DgStr;

{ Declarations ============================================================ }
{ Dialog Box declarations ------------------------------------------------- }

TYPE
  Coords = Record                                { for windows }
             Left, Top, Right, Bottom : byte;
             end;

  DbColorSet = Record
                 TextAttr, FrameAttr, MonoAttr : byte;
                 end;

  DialogBoxPtr = ^DialogBoxOb;
  DialogBoxOb = Object
    W1,                                          { outer window }
    W2        : ^RawWindow;                      { inner window }
    W1Coords,
    W2Coords  : Coords;                          { window coordinates }
    DbWidth   : byte;                            { width of dialog area }
    DbHeight  : byte;                            { height of dialog area }

    DbMsg     : string;                          { the actual dialog }
    DbColors  : DbColorSet;                      { local color set }
    DbOptions : word;                            { toggles }

    Constructor Init (Msg     : string;          { store the parameters }
                      Colors  : DbColorSet;
                      Options : byte;
                      Width   : byte);
    Destructor  Done;                            { close and dispose }
    Procedure   SetOptions (Option : word);      { set new options }
    Function    Db (Option : word) : boolean;    { is this option on? }

    Procedure   DbBeep;                          { beep cue }
    Procedure   DbClick;                         { click cue }

    Procedure   Draw;  virtual;                  { sets loc, calls DrawKernel }
    Procedure   DrawKernel;                      { does actual drawing }
    Procedure   Erase;                           { bye bye box }
    end;

  LowDialogBoxPtr = ^LowDialogBoxOb;
  LowDialogBoxOb = Object (DialogBoxOb)
    Procedure   Draw;  virtual;                  { puts box low on screen }
    end;

  RandomDialogBoxPtr = ^RandomDialogBoxOb;
  RandomDialogBoxOb = Object (DialogBoxOb)
    Procedure   Draw;  virtual;                  { locates box randomly }
    end;

CONST
  GreenDbColorSet : DbColorSet =
    (TextAttr  : WhiteOnGreen;
     FrameAttr : BlackOnGreen;
     MonoAttr  : BlackOnLtGray);

  RedDbColorSet : DbColorSet =
    (TextAttr  : WhiteOnRed;
     FrameAttr : BlackOnRed;
     MonoAttr  : BlackOnLtGray);

  CyanDbColorSet : DbColorSet =
    (TextAttr  : BlackOnCyan;
     FrameAttr : LtBlueOnCyan;
     MonoAttr  : BlackOnLtGray);

  BlueDbColorSet : DbColorSet =
    (TextAttr  : WhiteOnBlue;
     FrameAttr : LtCyanOnBlue;
     MonoAttr  : BlackOnLtGray);

  PopDbColorSet : DbColorSet =
    (TextAttr  : WhiteOnBrown;
     FrameAttr : BlackOnBrown;
     MonoAttr  : BlackOnLtGray);

{ Configure dialog box ---------------------------------------------------- }

  DbCues     = $01;                              { beep cues? }
  DbBoxClick = $02;                              { box click? }
  DbMusic    = $04;                              { Music? }
  DbSound    = $07;                              { all sounds }
                                                 { $08 is still free }
  DbJustify  = $10;                              { default is unjustified }
  DbCenter   = $20;                              { default is flush left }
  DbShadow   = $40;                              { add a shadow, if room }
  DbLowBox   = $80;                              { put box low }
{
  To use, pass these values to the DialogBox as Options.

  DbJustify will cause text to be justified in the box.  DbCenter will
  cause text to be centered.  DbJustify will have no effect if sent with
  DbCenter;  DbCenter will take precedence.
}

  BlBlank        = $01;                          { enable screen blanker }
  BlBlankWarning = $02;                          { enable warning msg }
  BlLock         = $04;                          { enable program lock }
  BlLockWarning  = $08;                          { enable warning msg }
  BlLogFile      = $10;                          { enable log file? }

  BlLockSet      = $1F;                          { blank, lock & file }
  BlOptions      : word = BlLockSet;

{ Program constants ------------------------------------------------------- }

CONST
  dgShadowColor : byte = DkGrayOnBlack;          { shadow attr color }
  dgShadowMono  : byte = DkGrayOnBlack;          { shadow attr mono }

  LockProgram_Password : string25 = 'Eat a bug'; { unlock program }
  TimeUntilBlank : longint = 180000;             { 3 minute screen blanker }
  BounceBoxWait  : longint = 7500;               { time between bounces }
  PopToggleFlag  : boolean = true;               { show toggles? }

{ Variables --------------------------------------------------------------- }

VAR
  Pause : Procedure;                             { configurable pause proc }
  Yorn  : Function (Msg : string) : boolean;     { configurable yes/no }
  PopMsgProc : Procedure (D : DialogBoxPtr);     { hook to PopMsgBox }

{ ========================================================================= }
{ Functions and Procedures ================================================ }

FUNCTION Bl (Option : word) : boolean;
{ returns true if BlOption is set }

PROCEDURE Wait;
{ waits for any keyboard activity }

FUNCTION WaitingPatiently (TimeToWait : longint) : boolean;
{
  Returns false if key is pressed before time is up.
  Displays date and time in upper right corner if DbByte clock bit is on.
}

FUNCTION InKeyWaiting (TimeToWait : longint) : boolean;
{ Returns false if ANY key is pressed before time is up. }

PROCEDURE BounceBox (MsgBox : RandomDialogBoxPtr);
{ Erases MsgBox and redraws it at a new location. }

PROCEDURE ScreenBlanker;
{ While WaitingPatiently do ScreenBlanker. . . . }

PROCEDURE LockProgram;
{ blanks screen, demands password to continue }

PROCEDURE NewPassword;
{ Gets a new password, puts it in LockProgram_Password. }

PROCEDURE PauseMsgLn (Msg : string);
{ Sends msg and pauses.  Waits for a keypress. }

PROCEDURE PauseLn;
{ Prompts:  'Press any key to continue.' }

PROCEDURE PauseMsgBox (Msg : string;  Colors : DbColorSet;
                       Options : word;  Width : byte);
{ Creates a dialog box with a custom message, waits for any keypress. }

PROCEDURE PauseBox;
{ Prompts:  'Press any key to continue.' in a dialog box. }

PROCEDURE TimedPauseMsg (Msg : string;  Colors : DbColorSet;
                         Options : word;  Width : byte;
                         TimeToWait : longint);
{ Creates a dialog box with a custom message, waits for a set time. }

PROCEDURE PopDummy (D : DialogBoxPtr);
{ Does nothing.  Default procedure for assignment to PopMsgProc. }

PROCEDURE PopMsgBox (Msg : string;  Colors : DbColorSet;
                     Options : word;  Width : byte;
                     DialogBox : DialogBoxPtr);
{ Creates a dialog box with a custom message, waits for alt-key release. }

PROCEDURE PopClock;
{ Pops a clock on screen until alt-key is released. }

PROCEDURE NotYet (S : string25);
{ TimedPauseMsg:  'Sorry, 'S' not implemented yet.' }

PROCEDURE Sorry;
{ TimedPauseMsg:  'Sorry.  Not implemented yet.' }

FUNCTION YornLn (Msg : string) : boolean;
{ Prints centered Msg on screen, demands a yes or no answer. }

FUNCTION YornBox (Msg : string) : boolean;
{ Opens a dialog box, demands a yes or no answer. }

PROCEDURE QuitProgram;
{ Do you really want to quit?  If yes, halt. }

PROCEDURE DoLines;
{ set configurable functions for line scrolling }

PROCEDURE DoBoxes;
{ set configurable functions for boxes }

{ ========================================================================= }
{ Implementation ========================================================== }

IMPLEMENTATION

{ ========================================================================= }
{ DialogBoxOb.Init ======================================================== }

CONSTRUCTOR DialogBoxOb.Init (Msg     : string;
                              Colors  : DbColorSet;
                              Options : byte;
                              Width   : byte);

VAR
  S : ^string;                                   { for internal use }

BEGIN
{
  Save all passed parameters.

  If the length of the message is less than the width of the dialog
  box, the length of the message will be used as the width of the box.
}
  DbMsg     := Msg;                              { save the message }
  DbColors  := Colors;
  DbOptions := Options;
  DbWidth   := Min (Width, Length (Msg));
{
  Do a dummy wordwrap to compute height of multiple line display.
}
  While DbWidth > (ScreenWidth - 12) do
    dec (DbWidth);                               { trap bad width }
  DbHeight := 0;
  new (S);                                       { allocate memory }
  While Msg > '' do begin                        { While Msg contains text }
    inc (DbHeight);                              { count number of lines }
    WordWrap (Msg, S^, Msg, DbWidth, false);     { needed to wordwrap }
    end;
  dispose (S);                                   { deallocate S }
  W1 := nil;                                     { flush pointers }
  W2 := nil;
END;

{ DialogBoxOb.Done ======================================================== }

DESTRUCTOR DialogBoxOb.Done;

BEGIN
{
  Just in case...close windows.
}
  if (W2 <> nil) or (W1 <> nil) then Erase;
END;

{ DialogBoxOb.SetOptions ================================================== }

PROCEDURE DialogBoxOb.SetOptions (Option : word);

BEGIN
  DbOptions := Option;
END;

{ DialogBoxOb.Db ========================================================== }

FUNCTION DialogBoxOb.Db (Option : word) : boolean;
{ returns true if option is set }

BEGIN
  Db := DbOptions and Option = Option;
END;

{ DialogBoxOb.DbClick ===================================================== }

PROCEDURE DialogBoxOb.DbClick;
{ dialog box sfx }
BEGIN
  if Db (DbBoxClick) then CueClick;
END;

{ DialogBoxOb.DbBeep ====================================================== }

PROCEDURE DialogBoxOb.DbBeep;
{ dialog box sfx }
BEGIN
  IF Db (DbCues) then Beep;
END;

{ DialogBoxOb.Draw ======================================================== }

PROCEDURE DialogBoxOb.Draw;

BEGIN
{
  First compute how much space will be needed for the actual dialog
  window.  Then compute the size of the outer border window.

  The fastest/easiest way to achieve a wide margin around a frame
  is simply to put the framed window inside a larger unframed one.
}
  with W2Coords do begin                         { inner window coords }
    { vertically centered dialog box }
    Top := (ScreenHeight - DbHeight) div 2;
    Bottom := Succ (Top + DbHeight);
    Left   := pred((ScreenWidth-DbWidth) div 2); { set left side of window }
    Right  := Left + DbWidth + 3;                { and right }
    end;

  with W1Coords do begin                         { outer window coords }
    Bottom := W2Coords.Bottom + 2;               { allow space for margins }
    Top    := W2Coords.Top - 2;
    Left   := W2Coords.Left - 5;
    Right  := W2Coords.Right + 5;
    end;
  DrawKernel;
END;

{ DialogBoxOb.DrawKernel ================================================== }

PROCEDURE DialogBoxOb.DrawKernel;

VAR
  LocalColorSet : ColorSet;                      { OpWindow color set }
  Msg : ^string;
  Height : byte;
  S : ^string;                                   { for internal use }
  StoreDbOptions : word;

BEGIN
{
  Set the attributes of the LocalColorSet.
}
  LocalColorSet.SetFrameAttr (DbColors.FrameAttr, DbColors.MonoAttr);
  LocalColorSet.SetTextAttr (DbColors.TextAttr, DbColors.MonoAttr);

{
  Belt and suspenders code.  Don't allow illegal coordinates.
}
  While W1Coords.Bottom > ScreenHeight do begin
    dec (W1Coords.Bottom);
    dec (W2Coords.Bottom);
    end;
  While W1Coords.Right > ScreenWidth do begin
    dec (W1Coords.Right);
    dec (W2Coords.Right);
    end;
  While W1Coords.Top < 1 do begin
    inc (W1Coords.Top);
    inc (W2Coords.Top);
    end;
  While W1Coords.Left < 1 do begin
    inc (W1Coords.Left);
    inc (W2Coords.Left);
    end;
{
  Watch out for shadow.
}
  StoreDbOptions := DbOptions;                   { save options }
  if                                             { if }
    (W1Coords.Bottom = ScreenHeight)             { no room at bottom }
      or                                         { or }
    (W1Coords.Right = ScreenWidth)               { no room at side }
  then                                           { then }
    DbOptions := DbOptions and not DbShadow;     { no shadow }


{
  Initialize the outer window, set its cursor to hidden, set it to have
  a shadow if there's room for it.
}
  with W1Coords do                               { allocate outer window }
    new (W1, InitCustom (Left, Top, Right, Bottom,
                         LocalColorSet, wclear));
  W1^.SetCursor (cuHidden);                      { hide the cursor }
  W1^.wFrame.SetShadowAttr (dgShadowColor, dgShadowMono, false);
  If (DbOptions and DbShadow = DbShadow) then
    W1^.wFrame.AddShadow (shBR, shSeeThru);      { declare a shadow }
  DbOptions := StoreDbOptions;                   { restore options }

{
  Initialize the inner window, set its cursor to hidden, set it to have
  a double-line frame.
}
  with W2Coords do                               { allocate inner window }
    new (W2, InitCustom (Left, Top, Right, Bottom,
                         LocalColorSet, wBordered));
  W2^.SetCursor (cuHidden);                      { hide the cursor }
  FramePtr (W2^.MainFramePtr)^.SetFrameType (DblWindowFrame);

{
  The Opro manual (page 4-89) says that the above construct is
  recommended to get the best future benefits of OOP, but it also
  acknowledges a more efficient way to achieve the same result:

  W2^.wFrame.SetFrameType (DblWindowFrame);
}
  W1^.Draw;                                      { outer window }
  W2^.Draw;                                      { inner window }

{
  Wordwrap the message.
}
  new (Msg);                                     { allocate Msg }
  new (S);                                       { allocate S }
  Msg^ := DbMsg;                                 { store DbMsg }
  Height := 1;
  While Msg^ > '' do begin                       { while there's text }
    inc (Height);
    Wordwrap (Msg^, S^, Msg^, DbWidth, false);        { get output line }
    if (DbOptions and DbCenter = DbCenter) then       { if center option }
      W2^.wFastCenter (S^, Height,                    { write centered }
        ColorMono (DbColors.TextAttr, DbColors.MonoAttr))
    else begin
      if (DbOptions and DbJustify = DbJustify) then   { if justify }
        if                                            { if not last line }
          (Msg^ > '') or (length (S^) > (DbWidth * 0.75))
        then                                          { or long last line }
          S^ := Justify (S^, DbWidth);                { justify }
      W2^.wFastWrite (S^, Height, 3,                  { write it }
        ColorMono (DbColors.TextAttr, DbColors.MonoAttr));
      end;
    end;
  dispose (S);                                   { deallocate S }
  dispose (Msg);                                 { deallocate Msg }
END;

{ DialogBoxOb.Erase ======================================================= }

PROCEDURE DialogBoxOb.Erase;

BEGIN
{
  Disposing automatically erases.
}
  if (W1 <> nil) and (W2 <> nil) then begin
    dispose (W2, Done);                          { deallocate windows }
    dispose (W1, Done);
    W1 := nil;
    W2 := nil;
    end;
END;

{ LowDialogBoxOb.Draw ===================================================== }

PROCEDURE LowDialogBoxOb.Draw;

BEGIN
{
  First compute how much space will be needed for the actual dialog
  window.  Then compute the size of the outer border window.

  The fastest/easiest way to achieve a wide margin around a frame
  is simply to put the framed window inside a larger unframed one.
}
  with W2Coords do begin                         { inner window coords }
    { this will locate the dialog box 2 rows from the bottom }
    Bottom := ScreenHeight - 4;                  { leave space at bottom }
    Top    := pred (Bottom - DbHeight);          { leave space for margin }
    Left   := pred((ScreenWidth-DbWidth) div 2); { set left side of window }
    Right  := Left + DbWidth + 3;                { and right }
    end;

  with W1Coords do begin                         { outer window coords }
    Bottom := W2Coords.Bottom + 2;               { allow space for margins }
    Top    := W2Coords.Top - 2;
    Left   := W2Coords.Left - 5;
    Right  := W2Coords.Right + 5;
    end;
  DrawKernel;
  Beep;
END;

{ RandomDialogBoxOb.Draw ================================================== }

PROCEDURE RandomDialogBoxOb.Draw;
{
  Locates the box randomly on screen.  Does not click or beep.
  Intended for use with ScreenBlanker and LockProgram.
}

BEGIN
{
  First compute how much space will be needed for the actual dialog
  window.  Then compute the size of the outer border window.

  The fastest/easiest way to achieve a wide margin around a frame
  is simply to put the framed window inside a larger unframed one.

  The numbers in the calculations below are to allow for the larger
  frame around the window.
}
  with W2Coords do begin                         { inner window coords }
    Top := 3 + Random (ScreenHeight - DbHeight - 5);  { random top }
    Bottom := succ (Top + DbHeight);                  { and bottom }
    Left := 6 + Random (ScreenWidth - DbWidth - 13);  { random left }
    Right := Left + DbWidth + 3;                      { and right }
    end;

  with W1Coords do begin                         { outer window coords }
    Bottom := W2Coords.Bottom + 2;               { allow space for margins }
    Top    := W2Coords.Top - 2;
    Left   := W2Coords.Left - 5;
    Right  := W2Coords.Right + 5;
    end;

(*
{
  For debugging only.  This code will write the outer
  box coordinates to the screen and halt the program if,
  for any reason, an illegal box coordinate is generated.

  The coordinate generating code has been debugged.  If
  changes are made to it, reinclude this code until you
  are sure that the new code has been thoroughly fumigated.
}
  with w1coords do begin
    WriteLn ('b: ', bottom);
    WriteLn ('t: ', top);
    WriteLn ('l: ', left);
    WriteLn ('r: ', right);
    end;

  if
    (W1Coords.Bottom > (ScreenHeight))
      or
    (W1Coords.Right > (ScreenWidth))
  then begin
    WriteLn ('Bottom = ', W1Coords.Bottom);
    WriteLn ('Right = ', W1Coords.Right);
    halt;
    end;
*)
  DrawKernel;                                    { do it }
END;

{ ========================================================================= }
{ Bl ====================================================================== }

FUNCTION Bl (Option : word) : boolean;
{ returns true if BlOption is set }
BEGIN
  Bl := BlOptions and Option = Option;
END;

{ Wait ==================================================================== }

PROCEDURE Wait;
{
  Waits for any keyboard activity -- will recognize all normal keys,
  all control keys, and all shift keys, including Alt and Ctrl.  Wait
  will flush any key pressed, with this very important exception:
  If the user hits a shift, Alt, or Ctrl key, and holds it down, then
  he's probably going to type a shifted, alternate, or control character.

  The wait routine will allow the press of a shift, alt, or ctrl key to
  toggle the KeyStateByte in case the user wants to hit a shifted char;
  but if not, and he releases the shift, alt, or ctrl key, then the
  KeyStateByte returns to normal.
}
VAR
  StoreState      : byte;

BEGIN
  StoreState := KeyStateByte;                    { save status of lock keys }
  repeat until
    KeyOrButtonPressed or (StoreState <> KeyStateByte);
  FlushKbd;                                      { flush keyboard }
  KeyStateByte :=
    (KeyStateByte and $F) or (StoreState and $F0);
  KeyClick;                                      { sound cue }
{
  (KeyStateByte and $F) means save the bit if any of the lower four
  shift keys are pressed, but throw away the bit if any of the upper
  four keys are pressed.  This is the CURRENT state of the KeyStateByte.

  (StoreState and $F0) means save the states of the upper four, the Lock
  keys, but throw away the states of the lower four shift keys.  This is
  the SAVED state of the KeyStateByte.

  Using the OR function to combine the current state of the KeyStateByte's
  lower four bits with the saved state of the KeyStateByte's upper four
  bits allows the function to maintain the status of all lock keys, while
  allowing the shift, alt, ctrl keys to pass their new states, if needed.

  If the user removes his finger from the shift, alt, or ctrl keys, the
  KeyStateByte returns to normal.

  Without this way of saving the states, if the user wanted to hit a
  shift, alt, or ctrl key, he'd have to remove his finger from the
  keyboard and then hit it again.  In normal usage, this would not only
  be annoying, it could leave the user wondering if his keyboard had
  broken.

  This method allows the user to toggle the end of a wait by hitting ANY
  key on the keyboard, including a shift key, and then lets him proceed
  naturally with any other keystroke necessary without his having to remove
  his finger from the shift key.
}
END;

{ WaitingPatiently ======================================================== }

FUNCTION WaitingPatiently (TimeToWait : longint) : boolean;
{
  Returns false if key is pressed before time is up.
  Displays date and time in upper right corner if ClockFlag is true.
  TimeToWait is computed in milleseconds.  100 is 1 tenth of a second.
  1000 is one second.  60000 is one minute.  180000 is three minutes.
}

VAR
  Start, Stop  : longint;
  StoreState   : byte;

BEGIN
  WaitingPatiently := false;                     { assume key is pressed }
  Start := TimeMs;                               { log start time }
  StoreState := KeyStateByte;                    { save shift key states }
  Repeat                                         { start counting }
    ShowClock;                                   { show time, if enabled }
    Stop := TimeMs;                              { time to quit yet? }
    if
      (Stop < Start)                             { if midnight has occurred }
        or                                       { or }
      (StoreState <> KeyStateByte)               { if a shift-key is hit }
    then begin                                   { then }
      StoreState := KeyStateByte;                { save it and }
      Start := TimeMs;                           { start counting again }
      end;
    if KeyOrButtonPressed then exit;             { keypress returns false }
  Until
    (Stop - Start) > TimeToWait;                 { we waited till the end }
  WaitingPatiently := true;                      { no key struck in time }
END;                                             { return true }

{ InKeyWaiting ============================================================ }

FUNCTION InKeyWaiting (TimeToWait : longint) : boolean;
{
  Returns false if key is pressed before time is up.
  Displays date and time in upper right corner if ClockFlag is true.
  Different than WaitingPatiently:
    also returns on shift, alt, and ctrl keys.
    flushes keyboard before returning.
}

VAR
  Start, Stop  : longint;
  StoreState   : byte;

BEGIN
  repeat until AltKeyReleased;                   { flush alt key }
  FlushKbd;                                      { flush anything else }
  InKeyWaiting := false;                         { assume key is pressed }
  Start := TimeMs;                               { log start time }
  KeyStateByte := KeyStateByte and $F0;          { turn off shift keys }
  StoreState := KeyStateByte;                    { save shift key states }
  Repeat                                         { start counting }
    ShowClock;                                   { show time, if enabled }
    Stop := TimeMs;                              { time to quit yet? }
    if
      Stop < Start                               { if midnight has occurred }
    then                                         { then }
      Start := TimeMs;                           { start counting again }
    if
      KeyOrButtonPressed                         { keypress }
        or                                       { or }
      (StoreState <> KeyStateByte)               { shift key }
    then begin                                   { then get out }
      FlushKbd;
      KeyClick;                                  { sound cue }
      exit;                                      { returns false }
      end;
  Until
    (Stop - Start) > TimeToWait;                 { we waited till the end }
  InKeyWaiting := true;                          { no key struck in time }
END;                                             { return true }

{ BounceBox =============================================================== }

PROCEDURE BounceBox (MsgBox : RandomDialogBoxPtr);
VAR
  StoreDbOptions : word;

BEGIN
  MsgBox^.Erase;                                 { erase msg }
  MsgBox^.Draw;                                  { show msg }
END;

{ ClickOnce =============================================================== }

PROCEDURE ClickOnce;
{ Guarantees correct click will sound. }
BEGIN
  if not Sfx (SfxKeyClick) then CueClick;        { sound cue }
END;

{ ScreenBlanker =========================================================== }

PROCEDURE ScreenBlanker;
{
  The operative code is:

    While
      WaitingPatiently (TimeUntilBlank)
    do
      ScreenBlanker;

  WaitingPatiently returns false if a key is pressed and true if
  no key is pressed before the number of milleseconds specified in
  TimeUntilBlank has elapsed.

  If WaitingPatiently returns true, the ScreenBlanker will open
  a blank window, then wait for a key to be pressed -- at which
  point, control is passed back to WaitingPatiently, to repeat the
  process until WaitingPatiently returns false.  When WaitingPatiently
  returns false the key pressed is passed to the program's I/O routines.
}

VAR
  W : WindowPtr;                                 { window in memory }
  MsgBox   : ^RandomDialogBoxOb;                 { pointer to popup box }
  MouseState : boolean;                          { mouse condition }

BEGIN
  if not Bl (BlBlank) then exit;                 { if screen blanker on }
  ClickOnce;                                     { sound cue }
  HideMousePrim (MouseState);                    { no mouse cursor }
  new (W, Init (1, 1, ScreenWidth, ScreenHeight));   { set window pointer }
  if Bl (BlBlankWarning) then
    new (MsgBox, Init ('The screen is blanked to prevent image ' +
                       'burn-in.  Press any key to return to the ' +
                       'program.', BlueDbColorSet, DbJustify, 24));

  W^.SetCursor (cuHidden);                       { turn off cursor }
  W^.Draw;                                       { show window }
  if Bl (BlBlankWarning) then begin
    MsgBox^.Draw;
    While InKeyWaiting (BounceBoxWait) do
      BounceBox (MsgBox)                         { relocates msg box }
    end
  else
    Wait;                                        { includes KeyClick }
  ClickOnce;                                     { but just in case }
  if Bl (BlBlankWarning) then
    Dispose (MsgBox, Done);                      { get rid of blank msg }
  Dispose (W, Done);                             { close and dispose }
  ShowMousePrim (MouseState);                    { bring back mouse cursor }
END;

{ WriteLogFile ============================================================ }

PROCEDURE WriteLogFile (S : StringPtr);

BEGIN
  If ExistFile (LogFileName) then
    Append (LogFile)
  else begin
    Rewrite (LogFile);
    WriteLn (LogFile,
      'An unauthorized attempt to access this computer may have occurred.');
    WriteLn (LogFile);
    end;
  WriteLn (LogFile, TimeStamp + ': ' + S^);
  Close   (LogFile);
END;

{ ValidatePassword ======================================================== }

PROCEDURE ValidatePassword;
{ checks user-entered password }
VAR
  S  : StringPtr;
  Ch : char;
  MsgBox : ^RandomDialogBoxOb;                   { pointer to warning msg }
  TimeCtr : longint;                             { count the time }
  TryCtr  : word;                                { how many tries? }
  StoreSfxOptions : longint;                     { save sound effects }

BEGIN
  if LockProgram_Password = '' then
    ScreenBlanker
  else begin
    if Bl (BlBlankWarning) then
      New (MsgBox, Init ('This computer is locked.  ' +
                         'You must enter the correct password ' +
                         'to restore normal operation.',
                          RedDbColorSet, DbJustify, 27));
    new (S);                                     { allocate string }
    TimeCtr := TimeMs;                           { start count }
    if Bl (BlBlankWarning) then MsgBox^.Draw;    { show first msg }
    TryCtr := 0;                                 { count number of tries }
    repeat
      S^ := '';                                  { flush string }
      Ch := #0;
      repeat
        if Bl (BlBlankWarning) then begin        { if show msg then }
          if TimeMs < TimeCtr then               { if midnight then }
            TimeCtr := TimeMs;                   { reset count }
          if
            TimeMs - TimeCtr > BounceBoxWait     { if time then }
          then begin
            TimeCtr := TimeMs;                   { restart time count }
            BounceBox (MsgBox)                   { relocate msg box }
            end;
          end;
        if keypressed then begin
          Ch := ReadKey;                         { get char }
          KeyClick;                              { sound cue }
          S^ := S^ + Ch;                         { add it to string }
          end;
      until                                      { until }
        Ch = #13;                                { Enter key is pressed }
      ClickOnce;
      dec (S^ [0]);                              { subtract Enter key }
      if
        CompUcString (S^, LockProgram_Password) <> equal  { if wrong }
      then begin
        inc (TryCtr);                            { count the tries }
        StoreSfxOptions := SfxOptions;
        SfxOptions := SfxOptions or SfxSound;    { enable all sounds }
        Case TryCtr of                           { make funny noise }
          1..3       : Bonk;
          4..6       : BadBuzzer;
          7..9       : IndustrialSiren;
          10..12     : RealBadBuzzer;
          13..MaxInt : IncBuzzer;
          end; { Case }
        SfxOptions := StoreSfxOptions;
        if (TryCtr > 3) and Bl (BlLogFile) then  { if 3+ attempts then }
          WriteLogFile (S);                      { record them }
        end
      else begin                                 { else }
        dispose (S);                             { deallocate string }
        if Bl (BlBlankWarning) then
          dispose (MsgBox, Done);                { deallocate lockout msg }
        exit;                                    { leave }
        ClickOnce;                               { make a sound }
        end;
    until
      true = false;                              { no exit here }
    end;
END;

{ ReportLogFile =========================================================== }

PROCEDURE ReportLogFile;

VAR
  S  : ^string;
  Ch : char;

BEGIN
  If ExistFile (LogFileName) then begin
    Reset (LogFile);
    new (S);
    While not Eof (LogFile) do begin
      ReadLn (LogFile, S^);
      WryteLn (S^);
      end;
    dispose (S);
    WryteLn ('');
    WryteLn ('Erase file?');
    Ch := upcase (ReadKey);
    KeyClick;                                    { sound cue }
    ClickOnce;                                   { just in case }
    ClrScr;
    If Ch = 'Y' then erase (LogFile);
    end;
END;

{ LockProgram ============================================================= }

PROCEDURE LockProgram;
{ blanks screen, demands password to continue }
VAR
  W : WindowPtr;                                 { window in memory }
  MouseState : boolean;                          { mouse condition }

BEGIN
  if not Bl (BlLock) then exit;                  { lock not authorized }
  DisableReboot;                                 { forbid Ctrl-Alt-Delete }
  HideMousePrim (MouseState);                    { no mouse cursor }
  New (W, Init (1, 1, ScreenWidth, ScreenHeight));   { set window pointer }
  W^.SetCursor (cuHidden);                       { turn off cursor }
  W^.Draw;                                       { show empty window }

  ClickOnce;                                     { sound cue }
  ValidatePassword;                              { unlock system? }

  ReportLogFile;                                 { check for break-ins }
  Dispose (W, Done);                             { close and dispose }
  ShowMousePrim (MouseState);                    { bring back mouse cursor }
  BuzzCounter := 1;                              { reset length of badbuzz }
  EnableReboot;                                  { allow Ctrl-Alt-Delete }
END;

{ NewPassword ============================================================= }

PROCEDURE NewPassword;
{ Gets a new password, puts it in LockProgram_Password. }

BEGIN
  NotYet ('New Password');
END;

{ PauseMsgLn ============================================================== }

PROCEDURE PauseMsgLn (Msg : string);
{ Sends a one-line msg, then waits for a keypress. }

VAR
  StoreTextAttr : byte;
  Len : byte absolute Msg;

BEGIN
  StoreTextAttr := TextAttr;
  TextAttr := ColorMono (LightRed, White);
  WryteLn ('');
  Wryte (PadCenter (Msg, ScreenWidth));
  Beep;
  While WaitingPatiently (TimeUntilBlank) do ScreenBlanker;
  FlushKbd;
  KeyClick;
  TextAttr := StoreTextAttr;
END;

{ PauseLn ================================================================ }

{$F+} PROCEDURE PauseLn; {$F-}
BEGIN
  PauseMsgLn ('Press any key to continue.');
END;

{ PauseMsgBox ============================================================= }

PROCEDURE PauseMsgBox (Msg : string;  Colors : DbColorSet;
                       Options : word;  Width : byte);
{
Creates a dialog box with user-defined message, waits for keypress.
}
VAR
  DialogBox : DialogBoxPtr;

BEGIN
  if Options and DbLowBox = DbLowBox then
    DialogBox := new (LowDialogBoxPtr, init (Msg, Colors, Options, Width))
  else
    DialogBox := new (DialogBoxPtr, init (Msg, Colors, Options, Width));
  With DialogBox^ do begin
    Draw;
    if not Db (DbCues) and not Sfx (SfxKeyClick) then DbClick else DbBeep;
    While InKeyWaiting (TimeUntilBlank) do ScreenBlanker;
    FlushKbd;
    if not Sfx (SfxKeyClick) then DbClick;
    end;
  dispose (DialogBox, Done);                     { automatically erases }
END;

{ PauseBox ================================================================ }

{$F+} PROCEDURE PauseBox; {$F-}

BEGIN
  PauseMsgBox ('Press any key to continue.', RedDbColorSet,
               DbShadow + DbLowBox + DbSound + DbLowBox, 40);
END;

{ TimedPauseMsg =========================================================== }

PROCEDURE TimedPauseMsg (Msg : string;  Colors : DbColorSet;
                         Options : word;  Width : byte;
                         TimeToWait : longint);
{ Creates a dialog box with a custom message, waits for a set time. }

VAR
  DialogBox : DialogBoxPtr;

BEGIN
  if Options and DbLowBox = DbLowBox then
    DialogBox := new (LowDialogBoxPtr, init(Msg, Colors, Options, Width))
  else
    DialogBox := new (DialogBoxPtr, init (Msg, Colors, Options, Width));
  with DialogBox^ do begin
    Draw;
    if not Db (DbCues) and not Sfx (SfxKeyClick) then DbClick else DbBeep;
    if InKeyWaiting (TimeToWait) then FlushKbd;
    DbClick;
    end;
  dispose (DialogBox, Done);                     { automatically erases }
END;

{ PopDummy ================================================================ }

{$F+} PROCEDURE PopDummy (D : DialogBoxPtr);  {$F-}
{ Does nothing.  Default procedure for assignment to PopMsgProc. }

BEGIN
END;

{ PopMsgBox =============================================================== }

PROCEDURE PopMsgBox (Msg : string;  Colors : DbColorSet;
                     Options : word;  Width : byte;
                     DialogBox : DialogBoxPtr);
{ Creates a dialog box with a custom message, waits for alt-key release. }

BEGIN
  If Options and DbLowBox = DbLowBox then
    DialogBox := new (LowDialogBoxPtr, init(Msg, Colors, Options, Width))
  else
    DialogBox := new (DialogBoxPtr, init (Msg, Colors, Options, Width));
  with DialogBox^ do begin
    Draw;
    if not Db (DbCues) and not Sfx (SfxKeyClick) then DbClick else DbBeep;

    TimeCheck := CurrentTime;
    PopMsgProc (DialogBox);                      { show first msg }
    Delay (150);                                 { allow for click }

    repeat                                       { now cycle }
      PopMsgProc (DialogBox);                    { passed proc }
      FlushKbd;                                  { discard typamatic }
    until
      AltKeyReleased;

    DbClick;                                     { sound cue }
    end;  { with DialogBox^ do }
  dispose (DialogBox, Done);                     { automatically erases }
  PopMsgProc := PopDummy;                        { reassign the dummy }
END;

{ PopClockProc ============================================================ }

{$F+} PROCEDURE PopClockCycle (DialogBox : DialogBoxPtr);  {$F-}
{ PopClock assigns this procedure to PopMsgProc for use by PopMsgBox. }

VAR
  A : byte;                                      { attribute }

BEGIN
  A := ColorMono (DialogBox^.DbColors.TextAttr,
                  DialogBox^.DbColors.MonoAttr); { get attr }
  DialogBox^.W2^.wFastCenter
    (PadCenter (FullDate, 30), 2, A);            { write date }
  DialogBox^.W2^.wFastCenter (PcTime, 4, A);     { write time }
  if ClockFlag then ClockProc;                   { update onscreen clock? }
  TickTock;                                      { make clock noise }
  Chimes;                                        { chime on the hour }
END;

{ PopClock ================================================================ }

PROCEDURE PopClock;
{ Pops a clock on screen until alt-key is released. }

VAR
  DialogBox     : DialogBoxPtr;

BEGIN
  PopMsgProc := PopClockCycle;                   { assign a procedure }
  PopMsgBox (CharStr (#255, 70),                 { pop a clear box }
            BlueDbColorSet,
            DbCenter + DbShadow + DbBoxClick,
            30,                                  { width }
            DialogBox);                          { pointer }
END;

{ NotYet ================================================================== }

PROCEDURE NotYet (S : string25);
{ TimedPauseMsg:  'Sorry, 'S' not implemented yet.' }
BEGIN
  TimedPauseMsg ('Sorry, but the ''' + S +
    ''' function has not been implemented yet.',
    RedDbColorSet, DbShadow + DbJustify + DbSound, 40, 1500);
END;

{ Sorry ================================================================== }

PROCEDURE Sorry;
{ TimedPauseMsg:  'Sorry.  Not implemented yet.' }
BEGIN
  TimedPauseMsg ('Sorry.  Not implemented yet.',
    RedDbColorSet,
    DbShadow + DbJustify + DbSound,
    40, 1500);
END;

{ YornLn ================================================================== }

{$F+} FUNCTION YornLn (Msg : string) : boolean; {$F-}
{ Prints centered Msg on screen, demands a yes or no answer. }

VAR
  Ch    : char;
  ChVal : word;
  StoreTextAttr : byte;

BEGIN
  StoreTextAttr := TextAttr;
  TextAttr := ColorMono (LightRed, White);
  WryteLn ('');
  Wryte (PadCenter (Msg, ScreenWidth));

  Ch := #0;
  While
    (Ch <> 'Y') and (Ch <> 'N')
  do begin
    While
      WaitingPatiently (TimeUntilBlank)          { 3 minutes }
    do
      ScreenBlanker;

    CueClick;                                    { sound cue }
    Ch := UpCaseMac (chr (lo (ReadKeyWord)));
    Case Ch of
      'Y' : YornLn := true;
      'N' : YornLn := false;
    else
      Beep;
      end;  { case }
    end;  { While do begin }

  TextAttr := StoreTextAttr;
END;

{ YornBox ================================================================= }

{ MakeMenu code ----------------------------------------------------------- }

CONST
  MouseChar : Char = #04;

{Color set used by menu system}
  YornMenuColors : ColorSet = (
    TextColor       : YellowOnRed;        TextMono        : LtGrayOnBlack;
    CtrlColor       : YellowOnBlue;       CtrlMono        : WhiteOnBlack;
    FrameColor      : RedOnRed;           FrameMono       : LtGrayOnBlack;
    HeaderColor     : RedOnRed;           HeaderMono      : BlackOnLtGray;
    ShadowColor     : DkGrayOnBlack;      ShadowMono      : WhiteOnBlack;
    HighlightColor  : WhiteOnRed;         HighlightMono   : BlackOnLtGray;
    PromptColor     : BlackOnCyan;        PromptMono      : LtGrayOnBlack;
    SelPromptColor  : BlackOnCyan;        SelPromptMono   : LtGrayOnBlack;
    ProPromptColor  : BlackOnCyan;        ProPromptMono   : LtGrayOnBlack;
    FieldColor      : YellowOnBlue;       FieldMono       : LtGrayOnBlack;
    SelFieldColor   : BlueOnCyan;         SelFieldMono    : WhiteOnBlack;
    ProFieldColor   : LtGrayOnBlue;       ProFieldMono    : LtGrayOnBlack;
    ScrollBarColor  : CyanOnBlue;         ScrollBarMono   : LtGrayOnBlack;
    SliderColor     : CyanOnBlue;         SliderMono      : WhiteOnBlack;
    HotSpotColor    : BlackOnCyan;        HotSpotMono     : BlackOnLtGray;
    BlockColor      : YellowOnCyan;       BlockMono       : WhiteOnBlack;
    MarkerColor     : WhiteOnMagenta;     MarkerMono      : BlackOnLtGray;
    DelimColor      : BlueOnCyan;         DelimMono       : WhiteOnBlack;
    SelDelimColor   : BlueOnCyan;         SelDelimMono    : WhiteOnBlack;
    ProDelimColor   : BlueOnCyan;         ProDelimMono    : WhiteOnBlack;
    SelItemColor    : BlackOnLtGray;      SelItemMono     : BlackOnLtGray;
    ProItemColor    : RedOnRed;           ProItemMono     : LtGrayOnBlack;
    HighItemColor   : WhiteOnRed;         HighItemMono    : WhiteOnBlack;
    AltItemColor    : WhiteOnBlue;        AltItemMono     : WhiteOnBlack;
    AltSelItemColor : WhiteOnCyan;        AltSelItemMono  : BlackOnLtGray;
    FlexAHelpColor  : WhiteOnBlue;        FlexAHelpMono   : WhiteOnBlack;
    FlexBHelpColor  : WhiteOnBlue;        FlexBHelpMono   : WhiteOnBlack;
    FlexCHelpColor  : LtCyanOnBlue;       FlexCHelpMono   : BlackOnLtGray;
    UnselXrefColor  : YellowOnBlue;       UnselXrefMono   : LtBlueOnBlack;
    SelXrefColor    : WhiteOnMagenta;     SelXrefMono     : BlackOnLtGray;
    MouseColor      : WhiteOnRed;         MouseMono       : BlackOnLtGray
  );

{Menu item constants}
CONST
  miYes1 = 1;
  miNo2  = 2;

{$F+}
procedure ErrorHandler(UnitCode : Byte; var ErrCode : Word; Msg : string);
  {-Report errors}
begin
end;
{$F-}

{ YornBox ------------------------------------------------------------------ }

{$F+} FUNCTION YornBox (Msg : string) : boolean; {$F-}
{ Opens a dialog box, demands a yes or no answer. }

VAR
  DialogBox : DialogBoxPtr;
  M : Menu;                                      { menu system }

  SlidingMargin,
  LeftButton,
  RightButton : byte;

BEGIN
  DialogBox := new (DialogBoxPtr,
                    init (Msg, RedDbColorSet, DbShadow + DbJustify, 40));
  DialogBox^.Draw;

  with M do begin
    LeftButton := 6;
    RightButton := (DialogBox^.W1Coords.Right - DialogBox^.W1Coords.Left - 7);
    SlidingMargin := 0;
    if RightButton - LeftButton > 16 then
      SlidingMargin := trunc ((RightButton - LeftButton)/4);

    if not InitCustom(DialogBox^.W1Coords.Left,
                      DialogBox^.W2Coords.Bottom + 2,
                      DialogBox^.W1Coords.Right,
                      DialogBox^.W2Coords.Bottom + 3,
                      YornMenuColors,
                      wClear+wUserContents+wCoversOnDemand,
                      Horizontal)
    then begin
      WriteLn('Error initializing menu: ', InitStatus);
      Halt(1);
      end;

    mnOptionsOn(mnAlphaMatch+mnSelectOnMatch+mnPopOnSelect+mnAllHotSpots+
                mnSelectOnClick);
    mnOptionsOff(mnAllowPending+mnArrowSelect+mnUseItemForTopic);
    AddShadow (shBR, shSeeThru);
    AddItem(' Yes ', LeftButton + SlidingMargin, 2, miYes1);
    AddItem(' No ', RightButton - SlidingMargin, 2, miNo2);
    ItemsDone;

    SetErrorProc(ErrorHandler);
    end;

  if MouseInstalled then
    with YornMenuColors do begin
      {activate mouse cursor}
      SoftMouseCursor($0000, (ColorMono(MouseColor, MouseMono) shl 8)+
                             Byte(MouseChar));
      ShowMouse;
      {enable mouse support}
      MenuCommands.cpOptionsOn (cpEnableMouse);
    end;

  M.Draw;
  M.Process;

  if M.GetLastCommand = ccSelect then begin
    case M.MenuChoice of
      miYes1          : YornBox := true;
      miNo2           : YornBox := false;
      end; { case }
    end
  else
    case M.GetLastCommand of
      { Esc, MouseRt }
      ccQuit : begin
               Beep;                             { make noise }
               YornBox := false;
               end;
      end;  { case }

  M.Erase;
  M.Done;

  dispose (DialogBox, Done);
END;

{ QuitProgram ============================================================= }

PROCEDURE QuitProgram;
{ Do you really want to quit?  If yes, halt. }

VAR
  StoreTextAttr : byte;

BEGIN
  StoreTextAttr := TextAttr;
  TextAttr := ColorMono (LightRed, White);
  if Yorn ('Do you REALLY want to quit?') then halt;
  TextAttr := StoreTextAttr;
END;

{ DoLines ================================================================= }

PROCEDURE DoLines;
{ set configurable functions for line scrolling }
BEGIN
  Yorn := YornLn;
  Pause := PauseLn;
  PopToggleFlag := false;
END;

{ DoBoxes ================================================================= }

PROCEDURE DoBoxes;
{ set configurable functions for boxes }
BEGIN
  Yorn := YornBox;
  Pause := PauseBox;
  PopToggleFlag := true;
END;

{ ========================================================================= }
{ Initialization ========================================================== }

BEGIN
  DoLines;                                       { default is scrolling }
  PopMsgProc := PopDummy;                        { do nothing }
END.

{ ========================================================================= }
{ DgDialog History ======================================================== }

VERSION HISTORY:
  9004.06
    Added DbBlank option to DbByte to allow enabling and disabling of
    ScreenBlanker from a configuration menu.

    Allow LockProgram to exit on any keypress if no password set.

    Added NotYet procedure for debugging purposes.

  9004.08
    Added RandomDialogBox child of dialog box.  Pops the box to a
    random location.  No shadow if too close to edge.

    Added Erase method to DialogBoxOb.  Allows box to be erased and
    redrawn without requiring reinitializing.  Repeated calls to
    RandomDialogBox.Erase and .Draw will move box around screen at
    random....

    Added Db (Option) function.  Returns true if Option is installed in
    DbOption.  DbOption is now longint.

    Designed config menu.  Have not installed it yet.  Too bad it's too
    complex for an article...or is it?

  9004.10
    Added BounceBox procedure to Implementation section for use with
    ScreenBlanker.  BounceBox draws and Erases a msg in a RandomDialogBox.
    Added InKeyWaiting procedure for use with BounceBox.  Usage:
      While
        InKeyWaiting (TimeToWait)
      do
        BounceBox (DialogBox^);

  9004.11
    BounceBox now works with LockProgram warning msg.  LockProgram_Password
    must be ASCII characters.  (Is there value in allowing alt-chars?)

  9004.13
    Added an automatic logfile feature to LockProgram.  If anyone tries to
    break into a locked system, the logfile will record every password and
    the time it was entered.

  9004.15
    Implemented BadBuzzer, IndustrialSiren, RealBadBuzzer, in LockProgram
    routine.  These really ugly noises CANNOT be disabled.  The program
    must be able to protect itself in every way possible against any
    unauthorized entry.

  9004.30
    Made Pause a procedure variable, so it can be assigned PauseLn or
    PauseBox, depending on what the program needs -- or even a user-defined
    Pause procedure.  Default is PauseBox.

  9005.01
    Divided PauseMsg into PauseMsgBox and PauseMsgLn.

  9005.06
    Added PopMsgBox and PopClock procedure.  Added QuitProgram procedure.

  9005.08
    Installed PopMsgProc in PopMsgBox, allowing procedures to be passed
    and run within a popped box.  See PopClock and PopClockCycle.

    This technique can be used later to extend the power of other dialog
    boxes.

  9005.11
    Added DbSound options to DbOptions.  Allows Dialog Boxes to have their
    own sound cues.  Note that KeyClick and CueClick have two different
    functions.

  9005.12
    Added DoLines and DoBoxes for easy initialization of Pause and Yorn.
    Added PopToggleFlag.

  9007.10
    Added mouse-clicks to Wait, WaitingPatiently, InKeyWaitingPatiently,
    and YornKernel, so that the mouse can be used with all dialog functions.

  9009.01
    Added Yes/No menu to YornBox.

{ DgDialog Needs ========================================================== }

DIALOG BOX OPTION
  DisableOuterBox.

{ Bug Reports ============================================================= }

BUGS:
  No known bugs.

{ ========================================================================= }